home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / fsserial.zip / SERIAL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-27  |  25KB  |  791 lines
  1. Unit Serial;
  2.  
  3. {     SERIAL.PAS - 14 Jan 91
  4.                    15 Jan 91 (Last Modification)
  5.  
  6.       This unit is designed to allow the user to use a FOSSIL driver for
  7.       a serial unit that is event-driven aware.  To do this, the input
  8.       from the modem is given an event status number just like the mouse or
  9.       keyboard.  All input is then routed directly through the event driver
  10.       for all your dialogs to use.  The output to the modem is in the form
  11.       of a series of events that you can use or direct calls via an object.
  12.       Note that these calls are the basics and do not halt for buffer
  13.       overruns in either Tx or Rx.  Your application program will have to
  14.       monitor the serCarrier and serTxBuffer events to keep track if there
  15.       is a carrier or if there is room in the TX buffer for more to be
  16.       sent.
  17.  
  18.       Note that this unit was written to take advantage of many of the
  19.       FOSSIL drivers out on the market such as X00.SYS or BNU.COM.  If
  20.       the system does not detect a FOSSIL driver in memory, then it
  21.       resorts to standard interrupt driven serial I/O without the ability
  22.       to open up more than one port at a time. (Currently... This may
  23.       change in the future)
  24.  
  25.       ----------------
  26.       REVISION HISTORY
  27.       ----------------
  28.  
  29.       01-14-91  Designed and created the test version of the FOSSIL only
  30.                 version.  The internal serial routines have not yet been
  31.       written to be used with this Unit.  Created the Event evSerial.
  32.       Added a bunch of BASIC routines to the serial driver and made sure
  33.       that the FSerial.Idle routine was passing the correct stuff!
  34.  
  35.       01-15-91  Added Event checks for Carrier and Transmission Buffer
  36.                 overflow.
  37.  
  38.       01-22-91  Rearranged the LSList system as a TCollection to improve
  39.                 the disposal procedure.  Also created the serCarrierReq and
  40.       serTxBufferReq events so that the user can request a port status in
  41.       case for some reason he missed the toggle event.
  42.  
  43.       01-27-91  Created a command entry to return a string if the receive
  44.                 buffer has several characters in it insted of trying to send
  45.       each and every one via an event.  Also changed the SERIAL.PAS activated
  46.       events to seperate procedures so that you can call them directly if you
  47.       inherit the Object or use it seperatly.  There is also a procedure to
  48.       disable this system from creating Command events.  You can use it
  49.       either way now...
  50.  
  51. }
  52. {$F+,O+,R-,S-}
  53.  
  54. {$DEFINE FOSSILDRIVER} {This will check if a FOSSIL driver is in place and
  55.                         will install a standard serial port if the driver
  56.                         is not in memory. If this is undefined, then the
  57.                         FOSSIL routines are not compiled in and you use the
  58.                         standard Serial routines regardless}
  59.  
  60. { DEFINE SERIALDRIVER} {If this is undefined, then all the standard serial
  61.                         routines are left out. If the FOSSIL driver is not
  62.                         in memory then you are out of luck...}
  63.  
  64. Interface
  65.  
  66. Uses Dos, Drivers, Views, Objects;
  67.  
  68. {----------------------------------------------------------------------------}
  69.  
  70. CONST evSerial      = $8000;   {Define a Serial Event Message}
  71.  
  72.       stDupSerial   = 195;     {Duplicate Port Requested}
  73.       stOpenError   = 194;     {Error opening the port}
  74.       stInvalidPort = 193;     {Invalid port number}
  75.       stInvalidBaud = 192;     {Invalid selected baud rate}
  76.       stCharUnavail = 191;     {Tried to read a char, but none available}
  77.  
  78.       serBaud       = 7100;    {Set Baud Rate       (Port,Baud)}
  79.                                {Fmt:  InfoByte=Port, InfoLong=+Baud SHL 16}
  80.       serSend       = 7101;    {Send a char         (Port,Byte)}
  81.                                {Fmt:  InfoByte=Port, InfoWord=+Byte SHL 8}
  82.       serInit       = 7104;    {Initialize a port   (Port)}
  83.       serDeInit     = 7105;    {Remove a port       (Port)}
  84.       serRaiseDTR   = 7106;    {Raise the DTR       (Port)}
  85.       serLowerDTR   = 7107;    {Lower the DTR       (Port)}
  86.       serPurgeRx    = 7108;    {Purge the Recv buf  (Port)}
  87.       serPurgeTx    = 7109;    {Purge output buf    (Port)}
  88.       serFlow       = 7115;    {Set Flow Control    (Port,Flow)}
  89.                                {Fmt:  InfoByte=Port, InfoWord=+Flow SHL 8}
  90.       serCarrierReq = 7116;    {Request the Carrier Status (Port)}
  91.       serTxBufferReq= 7117;    {Request Tx Buffer Status (Port)}
  92.  
  93.       serEventGenOn = 7118;    {Turn on Serial Event Generation}
  94.       serEventGenOff= 7119;    {Turn off Serial Event Generation}
  95.  
  96.       serCarrier    = 7120;    {Carrier Status      (Port,Status)}
  97.       serTxBuffer   = 7121;    {TxBuffer Status     (Port,Status)}
  98.       serRecvChar   = 7122;    {Received a char     (Port,Byte)}
  99.       serRecvLine   = 7123;    {Received a line     (Port,Ptr -> String)}
  100.  
  101. {----------------------------------------------------------------------------}
  102.  
  103. TYPE  FossilList = RECORD
  104.                       strsiz  : WORD;
  105.                       majver  : BYTE;
  106.                       minver  : BYTE;
  107.                       ident   : POINTER;
  108.                       ibufr   : WORD;
  109.                       ifree   : WORD;
  110.                       obufr   : WORD;
  111.                       ofree   : WORD;
  112.                       swidth  : BYTE;
  113.                       sheight : BYTE;
  114.                       baud    : BYTE;
  115.                    END;
  116.  
  117. TYPE  PTypes = (SerNone,SerStd,SerFossil);
  118.       PSList = ^LSList;
  119.       LSList = OBJECT(TObject)
  120.                   SerialPort  : BYTE;
  121.                   PortType    : PTypes;
  122.                   BaudBits    : BYTE;
  123.                   FlowControl : BYTE;
  124.                   Carrier     : BOOLEAN;
  125.                   TxBuffer    : BOOLEAN;
  126.                   CONSTRUCTOR Init(Port : BYTE);
  127.                   CONSTRUCTOR Load(VAR S : TStream);
  128.                   PROCEDURE Store(VAR S : TStream);
  129.                   DESTRUCTOR Done; VIRTUAL;
  130.                END;
  131.  
  132.       RecvRec = RECORD
  133.                    Port : BYTE;
  134.                    St   : STRING
  135.                 END;
  136.  
  137. TYPE  PSerial = ^FSerial;
  138.       FSerial = OBJECT(TView)
  139.                    OpenPorts     : PCollection;
  140.                    LastPort      : BYTE;
  141.                    EventGenerate : BOOLEAN;
  142. {$IFDEF FOSSILDRIVER}
  143.                    FossilUsed    : BOOLEAN;
  144.                    FossilInfo    : FossilList;
  145. {$ENDIF}
  146.                    ErrorInfo     : INTEGER;
  147.                    CONSTRUCTOR Init;
  148.                    CONSTRUCTOR Load(VAR S : TStream);
  149.                    PROCEDURE Store(VAR S : TStream);
  150.  
  151.                    PROCEDURE InitPort(Port : BYTE);
  152.                    PROCEDURE RemovePort(Port : BYTE);
  153.                    PROCEDURE SetBaud(Port : BYTE; Baud : WORD);
  154.                    PROCEDURE PurgeOutputBuf(Port : BYTE);
  155.                    PROCEDURE PurgeInputBuf(Port : BYTE);
  156.                    PROCEDURE SendChar(Port : BYTE; Ch : BYTE);
  157.                    PROCEDURE SendLine(Port : BYTE; Ln : STRING);
  158.                    FUNCTION  RecvChar(Port : BYTE) : CHAR;
  159.                    PROCEDURE DTRState(Port : BYTE; UpDown : BOOLEAN);
  160.                    PROCEDURE FlowControl(Port : BYTE; Item : BYTE);
  161.                    PROCEDURE SerialRequest(ReqType : WORD; Port : BYTE);
  162.                    PROCEDURE GenerateEvents(Action : BOOLEAN);
  163.  
  164.                    PROCEDURE Reset;
  165.                    DESTRUCTOR Done; VIRTUAL;
  166.                    PROCEDURE Idle; VIRTUAL;
  167.                    PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
  168.                 END;
  169.  
  170. CONST RSerial: TStreamRec = (
  171.          ObjType: 7100;
  172.          VmtLink: Ofs(TypeOf(FSerial)^);
  173.          Load:    @FSerial.Load;
  174.          Store:   @FSerial.Store
  175.       );
  176.  
  177.       RSList: TStreamRec = (
  178.          ObjType: 7101;
  179.          VmtLink: Ofs(TypeOf(LSList)^);
  180.          Load:    @LSList.Load;
  181.          Store:   @LSList.Store
  182.       );
  183.  
  184. PROCEDURE RegisterSerial;
  185.  
  186. VAR   SerialSys : PSerial;
  187.  
  188. Implementation
  189.  
  190. CONST Fossil   = $14;
  191.       MaxPorts = 4;
  192.       Bauds    : ARRAY [0..7] OF WORD
  193.                = (19200,38400,300,600,1200,2400,4800,9600);
  194. VAR   Regs          : REGISTERS;
  195.       FossilPresent : BOOLEAN;
  196.       RecvBuf       : RecvRec;
  197.  
  198. {----------------------------------------------------------------------------}
  199.  
  200. CONSTRUCTOR LSList.Init;
  201. BEGIN
  202.    IF (Port < 0) OR (Port >= MaxPorts) THEN
  203.       FAIL;
  204.  
  205.    SerialPort  := Port;
  206.    PortType    := serNone;
  207.    BaudBits    := $03;
  208.    FlowControl := $01;
  209.    Carrier     := FALSE;
  210.    TxBuffer    := FALSE;
  211.  
  212. {$IFDEF FOSSILDRIVER}
  213.    IF FossilPresent THEN
  214.       BEGIN
  215.          Regs.AH := $04;
  216.          Regs.BX := $0000;
  217.          Regs.DX := Port;
  218.          INTR(Fossil,Regs);
  219.          IF Regs.AX = $1954 THEN
  220.             BEGIN
  221.                PortType := SerFossil;
  222.                Regs.AH := $0F;      {Set for Xon/Xoff processing}
  223.                Regs.AL := FlowControl;
  224.                INTR(Fossil,Regs)
  225.             END
  226.       END;
  227. {$ENDIF}
  228. {$IFDEF SERIALDRIVER}
  229.    IF PortType = SerNone THEN
  230.       BEGIN
  231.  
  232.       {Set up standard port with PortType=SerStd}
  233.  
  234.       END;
  235. {$ENDIF}
  236.    IF PortType = SerNone THEN
  237.       FAIL
  238. END;
  239.  
  240. {----------------------------------------------------------------------------}
  241.  
  242. CONSTRUCTOR LSList.Load;
  243. BEGIN
  244.    S.Read(SerialPort,SIZEOF(SerialPort));
  245.    S.Read(PortType,SIZEOF(PortType));
  246.    S.Read(BaudBits,SIZEOF(BaudBits));
  247.    S.Read(FlowControl,SIZEOF(FlowControl));
  248.    S.Read(Carrier,SIZEOF(Carrier));
  249.    S.Read(TxBuffer,SIZEOF(TxBuffer))
  250. END;
  251.  
  252. {----------------------------------------------------------------------------}
  253.  
  254. PROCEDURE LSList.Store;
  255. BEGIN
  256.    S.Write(SerialPort,SIZEOF(SerialPort));
  257.    S.Write(PortType,SIZEOF(PortType));
  258.    S.Write(BaudBits,SIZEOF(BaudBits));
  259.    S.Write(FlowControl,SIZEOF(FlowControl));
  260.    S.Write(Carrier,SIZEOF(Carrier));
  261.    S.Write(TxBuffer,SIZEOF(TxBuffer))
  262. END;
  263.  
  264. {----------------------------------------------------------------------------}
  265.  
  266. DESTRUCTOR LSList.Done;
  267. BEGIN
  268. {$IFDEF FOSSILDRIVER}
  269.    IF PortType = SerFossil THEN
  270.       BEGIN
  271.          Regs.AH := $05;
  272.          Regs.DX := SerialPort;
  273.          INTR(Fossil,Regs);
  274.          PortType := SerNone
  275.       END;
  276. {$ENDIF}
  277. {$IFDEF SERIALDRIVER}
  278.    IF PortType = SerStd THEN
  279.       BEGIN
  280.          {Take out our port!}
  281.  
  282.          PortType := SerNone
  283.       END;
  284. {$ENDIF}
  285. END;
  286.  
  287. {----------------------------------------------------------------------------}
  288.  
  289. FUNCTION ScanPorts(p : PCollection; Port : BYTE) : PSList;
  290.  
  291.    FUNCTION TestPort(p : PSList) : BOOLEAN ; FAR;
  292.    BEGIN
  293.       TestPort := (Port = p^.SerialPort)
  294.    END;
  295.  
  296. BEGIN
  297.    ScanPorts := p^.FirstThat(@TestPort)
  298. END;
  299.  
  300. {----------------------------------------------------------------------------}
  301.  
  302. CONSTRUCTOR FSerial.Init;
  303. VAR   R : TRect;
  304. BEGIN
  305.    GetExtent(R);
  306.    TView.Init(R);
  307.    SetState(sfVisible,FALSE);
  308.    EventMask := evSerial;
  309.    EventGenerate := FALSE;
  310.    OpenPorts := NEW(PCollection,Init(4,4));
  311. {$IFDEF FOSSILDRIVER}
  312.    FILLCHAR(FossilInfo,SIZEOF(FossilInfo),0);
  313.    Regs.AH := $1B;
  314.    Regs.CX := SIZEOF(FossilInfo);
  315.    Regs.DX := 1;
  316.    Regs.ES := SEG(FossilInfo);
  317.    Regs.DI := OFS(FossilInfo);
  318.    INTR(Fossil,Regs);
  319.    FossilPresent := (FossilInfo.majver >= 4) AND (FossilInfo.strsiz > 4);
  320. {$ENDIF}
  321.    Reset
  322. END;
  323.  
  324. {----------------------------------------------------------------------------}
  325.  
  326. CONSTRUCTOR FSerial.Load;
  327. BEGIN
  328.    TView.Load(S);
  329.  
  330. END;
  331.  
  332. {----------------------------------------------------------------------------}
  333.  
  334. PROCEDURE FSerial.Store;
  335. BEGIN
  336.    TView.Store(S);
  337.  
  338. END;
  339.  
  340. {----------------------------------------------------------------------------}
  341.  
  342. PROCEDURE FSerial.InitPort;
  343. VAR   p : PSList;
  344. BEGIN
  345.    Reset;
  346.    IF (Port < 0) OR (Port >= MaxPorts) THEN
  347.       BEGIN
  348.          ErrorInfo := stInvalidPort;
  349.          EXIT
  350.       END;
  351.  
  352.    IF ScanPorts(OpenPorts,Port) = NIL THEN
  353.       p := NEW(PSList,Init(Port))
  354.    ELSE
  355.       BEGIN
  356.          ErrorInfo := stDupSerial;
  357.          EXIT
  358.       END;
  359.  
  360.    IF p = NIL THEN
  361.       ErrorInfo := stOpenError
  362.    ELSE
  363.       OpenPorts^.Insert(p)
  364. END;
  365.  
  366. {----------------------------------------------------------------------------}
  367.  
  368. PROCEDURE FSerial.RemovePort;
  369. VAR   p : PSList;
  370. BEGIN
  371.    Reset;
  372.    p := ScanPorts(OpenPorts,Port);
  373.    IF p <> NIL THEN
  374.       OpenPorts^.Free(p)
  375.    ELSE
  376.       ErrorInfo := stInvalidPort;
  377. END;
  378.  
  379. {----------------------------------------------------------------------------}
  380.  
  381. PROCEDURE FSerial.SetBaud;
  382. VAR   BaudMask : BYTE;
  383.       p        : PSList;
  384. BEGIN
  385.    Reset;
  386.    BaudMask := 0;
  387.    WHILE (Bauds[BaudMask] <> Baud) AND (BaudMask < 8) DO
  388.       INC(BaudMask);
  389.    IF BaudMask > 7 THEN
  390.       BEGIN
  391.          ErrorInfo := stInvalidBaud;
  392.          EXIT
  393.       END;
  394.    p := ScanPorts(OpenPorts,Port);
  395.    IF p <> NIL THEN
  396.       BEGIN
  397. {$IFDEF FOSSILDRIVER}
  398.          IF p^.PortType = SerFossil THEN
  399.             BEGIN
  400.                p^.BaudBits := BaudMask SHL 5 + p^.BaudBits AND $1F;
  401.                Regs.AH := $00;
  402.                Regs.AL := p^.BaudBits;
  403.                Regs.DX := Port;
  404.                INTR(Fossil,Regs)
  405.             END;
  406. {$ENDIF}
  407. {$IFDEF SERIALDRIVER}
  408.          IF p^.PortType = SerStd THEN
  409.             BEGIN
  410.                {Change Our Baud Rate!}
  411.  
  412.             END
  413. {$ENDIF}
  414.       END
  415.    ELSE
  416.       ErrorInfo := stInvalidPort
  417. END;
  418.  
  419. {----------------------------------------------------------------------------}
  420.  
  421. PROCEDURE FSerial.PurgeOutputBuf;
  422. VAR   p : PSList;
  423. BEGIN
  424.    Reset;
  425.    p := ScanPorts(OpenPorts,Port);
  426.    IF p <> NIL THEN
  427.       BEGIN
  428. {$IFDEF FOSSILDRIVER}
  429.          IF p^.PortType = SerFossil THEN
  430.             BEGIN
  431.                Regs.AH := $09;
  432.                Regs.DX := p^.SerialPort;
  433.                INTR(Fossil,Regs)
  434.             END;
  435. {$ENDIF}
  436. {$IFDEF SERIALDRIVER}
  437.          IF p^.PortType = SerStd THEN
  438.             BEGIN
  439.             END;
  440. {$ENDIF}
  441.       END
  442.    ELSE
  443.       ErrorInfo := stInvalidPort
  444. END;
  445.  
  446. {----------------------------------------------------------------------------}
  447.  
  448. PROCEDURE FSerial.PurgeInputBuf;
  449. VAR   p : PSList;
  450. BEGIN
  451.    Reset;
  452.    p := ScanPorts(OpenPorts,Port);
  453.    IF p <> NIL THEN
  454.       BEGIN
  455. {$IFDEF FOSSILDRIVER}
  456.          IF p^.PortType = SerFossil THEN
  457.             BEGIN
  458.                Regs.AH := $0A;
  459.                Regs.DX := p^.SerialPort;
  460.                INTR(Fossil,Regs)
  461.             END;
  462. {$ENDIF}
  463. {$IFDEF SERIALDRIVER}
  464.          IF p^.PortType = SerStd THEN
  465.             BEGIN
  466.             END;
  467. {$ENDIF}
  468.       END
  469.    ELSE
  470.       ErrorInfo := stInvalidPort
  471. END;
  472.  
  473. {----------------------------------------------------------------------------}
  474.  
  475. PROCEDURE FSerial.SendChar;
  476. VAR   p : PSList;
  477. BEGIN
  478.    Reset;
  479.    p := ScanPorts(OpenPorts,Port);
  480.    IF p <> NIL THEN
  481.       BEGIN
  482. {$IFDEF FOSSILDRIVER}
  483.          IF p^.PortType = SerFossil THEN
  484.             BEGIN
  485.                Regs.AH := $01;
  486.                Regs.AL := ch;
  487.                Regs.DX := Port;
  488.                INTR(Fossil,Regs);   {Check AX returns....}
  489.             END;
  490. {$ENDIF}
  491. {$IFDEF SERIALDRIVER}
  492.          IF p^.PortType = SerStd THEN
  493.             BEGIN
  494.             END;
  495. {$ENDIF}
  496.       END
  497.    ELSE
  498.       ErrorInfo := stInvalidPort
  499. END;
  500.  
  501. {----------------------------------------------------------------------------}
  502.  
  503. PROCEDURE FSerial.SendLine;
  504. VAR   p : PSList;
  505. BEGIN
  506.    Reset;
  507.    p := ScanPorts(OpenPorts,Port);
  508.    IF p <> NIL THEN
  509.       BEGIN
  510. {$IFDEF FOSSILDRIVER}
  511.          IF (p^.PortType = SerFossil) AND (LENGTH(Ln) > 0) THEN
  512.             BEGIN
  513.                Regs.AH := $19;
  514.                Regs.CX := LENGTH(Ln);
  515.                Regs.DX := Port;
  516.                Regs.ES := SEG(Ln[1]);
  517.                Regs.DI := OFS(Ln[1]);
  518.                INTR(Fossil,Regs);   {Check AX returns....}
  519.             END;
  520. {$ENDIF}
  521. {$IFDEF SERIALDRIVER}
  522.          IF p^.PortType = SerStd THEN
  523.             BEGIN
  524.             END;
  525. {$ENDIF}
  526.       END
  527.    ELSE
  528.       ErrorInfo := stInvalidPort
  529. END;
  530.  
  531. {----------------------------------------------------------------------------}
  532.  
  533. PROCEDURE FSerial.DTRState;
  534. VAR   p : PSList;
  535. BEGIN
  536.    Reset;
  537.    p := ScanPorts(OpenPorts,Port);
  538.    IF p <> NIL THEN
  539.       BEGIN
  540. {$IFDEF FOSSILDRIVER}
  541.          IF p^.PortType = SerFossil THEN
  542.             BEGIN
  543.                Regs.AH := $06;
  544.                Regs.AL := BYTE(UpDown);
  545.                Regs.DX := Port;
  546.                INTR(Fossil,Regs)
  547.             END;
  548. {$ENDIF}
  549. {$IFDEF SERIALDRIVER}
  550.          IF p^.PortType = SerStd THEN
  551.             BEGIN
  552.             END;
  553. {$ENDIF}
  554.       END
  555.    ELSE
  556.       ErrorInfo := stInvalidPort
  557. END;
  558.  
  559. {----------------------------------------------------------------------------}
  560.  
  561. PROCEDURE FSerial.FlowControl;
  562. VAR   p : PSList;
  563. BEGIN
  564.    Reset;
  565.    p := ScanPorts(OpenPorts,Port);
  566.    IF p <> NIL THEN
  567.       BEGIN
  568. {$IFDEF FOSSILDRIVER}
  569.          IF p^.PortType = SerFossil THEN
  570.             BEGIN
  571.                Regs.AH := $0F;
  572.                Regs.AL := Item;
  573.                Regs.DX := p^.SerialPort;
  574.                INTR(Fossil,Regs)
  575.             END;
  576. {$ENDIF}
  577. {$IFDEF SERIALDRIVER}
  578.          IF p^.PortType = SerStd THEN
  579.             BEGIN
  580.             END;
  581. {$ENDIF}
  582.       END
  583.    ELSE
  584.       ErrorInfo := stInvalidPort
  585. END;
  586.  
  587. {----------------------------------------------------------------------------}
  588.  
  589. PROCEDURE FSerial.SerialRequest;
  590. VAR   p : PSList;
  591. BEGIN
  592.    Reset;
  593.    p := ScanPorts(OpenPorts,Port);
  594.    IF p <> NIL THEN
  595.       CASE ReqType OF
  596.          serCarrierReq  : p^.Carrier := NOT p^.Carrier;
  597.          serTxBufferReq : p^.TxBuffer := NOT p^.TxBuffer
  598.       END
  599.    ELSE
  600.       ErrorInfo := stInvalidPort
  601. END;
  602.  
  603. {----------------------------------------------------------------------------}
  604.  
  605. PROCEDURE FSerial.GenerateEvents;
  606. BEGIN
  607.    EventGenerate := Action
  608. END;
  609.  
  610. {----------------------------------------------------------------------------}
  611.  
  612. FUNCTION FSerial.RecvChar;
  613. VAR   p : PSList;
  614. BEGIN
  615.    Reset;
  616.    p := ScanPorts(OpenPorts,Port);
  617.    IF p <> NIL THEN
  618.       BEGIN
  619. {$IFDEF FOSSILDRIVER}
  620.          IF p^.PortType = SerFossil THEN
  621.             BEGIN
  622.                Regs.AH := $03;
  623.                Regs.DX := p^.SerialPort;
  624.                INTR(Fossil,Regs);
  625.                IF Regs.AH AND $01 = $01 THEN
  626.                   BEGIN
  627.                      Regs.AH := $02;
  628.                      INTR(Fossil,Regs);
  629.                      RecvChar := CHAR(Regs.AL)
  630.                   END
  631.                ELSE
  632.                   BEGIN
  633.                      RecvChar := #0;
  634.                      ErrorInfo := stCharUnavail
  635.                   END
  636.             END;
  637. {$ENDIF}
  638. {$IFDEF SERIALDRIVER}
  639.          IF p^.PortType = SerStd THEN
  640.             BEGIN
  641.             END;
  642. {$ENDIF}
  643.       END
  644.    ELSE
  645.       BEGIN
  646.          RecvChar := #0;
  647.          ErrorInfo := stInvalidPort
  648.       END
  649. END;
  650.  
  651. {----------------------------------------------------------------------------}
  652.  
  653. PROCEDURE FSerial.Reset;
  654. BEGIN
  655.    ErrorInfo := stOk
  656. END;
  657.  
  658. {----------------------------------------------------------------------------}
  659.  
  660. DESTRUCTOR FSerial.Done;
  661. BEGIN
  662.    DISPOSE(OpenPorts,Done);
  663.    TView.Done;
  664. END;
  665.  
  666. {----------------------------------------------------------------------------}
  667. {  NOTE:  The returned event that is created by the IDLE routine consists of }
  668. {         two major parts. First is the identification that this is a serial }
  669. {         event or type whatever (serCarrier,serTxBuffer,serRecv).  The      }
  670. {         second part is the InfoWord with the high byte being the port that }
  671. {         this message came in from and the low order being what the actual  }
  672. {         value was.  For Instance:                                          }
  673. {                                                                            }
  674. {         serCarrier  :=  HI(InfoWord) = 1  -> Carrier                       }
  675. {                         HI(InfoWord) = 0  -> No Carrier                    }
  676. {                                                                            }
  677. {         serTxBuffer :=  HI(InfoWord) = 1 -> Room Avail in output buffer    }
  678. {                         HI(InfoWord) = 0 -> No Room Avail in output buffer }
  679. {                                                                            }
  680. {         serRecvChar :=  HI(InfoWord)   -> Character Received               }
  681. {                                                                            }
  682. {         serRecvLine :=  InfoPointer    -> Points to a port/string record   }
  683. {                                                                            }
  684. {                         InfoByte       -> For all, gives the port number   }
  685. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  686.  
  687. PROCEDURE FSerial.Idle;
  688. VAR   Event : TEvent;
  689.       p     : PSList;
  690. BEGIN
  691.    IF (OpenPorts^.Count <> 0) THEN
  692.       BEGIN
  693.          LastPort := (LastPort + 1) MOD OpenPorts^.Count;
  694.          Event.What := evSerial;
  695.          p := OpenPorts^.AT(LastPort);
  696. {$IFDEF FOSSILDRIVER}
  697.          IF p^.PortType = SerFossil THEN
  698.             BEGIN
  699.                Regs.AH := $03;
  700.                Regs.DX := p^.SerialPort;
  701.                Event.InfoByte := Regs.DX;
  702.                INTR(Fossil,Regs);
  703.                IF p^.Carrier XOR (Regs.AL AND $80 = $80) THEN
  704.                   BEGIN
  705.                      p^.Carrier := NOT p^.Carrier;
  706.                      Event.Command := serCarrier;
  707.                      INC(Event.InfoWord,BYTE(p^.Carrier) SHL 8);
  708.                      IF EventGenerate THEN
  709.                         PutEvent(Event);
  710.                      EXIT
  711.                   END;
  712.                IF p^.TxBuffer XOR (Regs.AH AND $20 = $20) THEN
  713.                   BEGIN
  714.                      p^.TxBuffer := NOT p^.TxBuffer;
  715.                      Event.Command := serTxBuffer;
  716.                      INC(Event.InfoWord,BYTE(p^.TxBuffer) SHL 8);
  717.                      IF EventGenerate THEN
  718.                         PutEvent(Event);
  719.                      EXIT
  720.                   END;
  721.                IF EventGenerate AND (Regs.AH AND $01 = $01) THEN
  722.                   BEGIN
  723.                      Regs.AH := $18;
  724.                      Regs.CX := 255;
  725.                      Regs.ES := SEG(RecvBuf.St[1]);
  726.                      Regs.DI := OFS(RecvBuf.St[1]);
  727.                      INTR(Fossil,Regs);
  728.                      IF Regs.AX = 1 THEN
  729.                         BEGIN
  730.                            Event.Command := serRecvChar;
  731.                            INC(Event.InfoWord,BYTE(RecvBuf.St[1]) SHL 8);
  732.                            PutEvent(Event)
  733.                         END;
  734.                      IF Regs.AX > 1 THEN
  735.                         BEGIN
  736.                            Event.Command := serRecvLine;
  737.                            Event.InfoPtr := ADDR(RecvBuf);
  738.                            RecvBuf.Port := p^.SerialPort;
  739.                            RecvBuf.St[0] := CHAR(Regs.AX);
  740.                            PutEvent(Event)
  741.                         END
  742.                   END
  743.             END;
  744. {$ENDIF}
  745. {$IFDEF SERIALDRIVER}
  746.          IF p^.PortType = SerStd THEN
  747.             BEGIN
  748.  
  749.             END
  750. {$ENDIF}
  751.       END
  752. END;
  753.  
  754. {----------------------------------------------------------------------------}
  755.  
  756. PROCEDURE FSerial.HandleEvent;
  757. BEGIN
  758.    TView.HandleEvent(Event);
  759.    IF Event.What = evSerial THEN
  760.       CASE Event.Command OF
  761.          serBaud        : SetBaud(Event.InfoByte,Event.InfoLong SHR 16);
  762.          serSend        : SendChar(Event.InfoByte,HI(Event.InfoWord));
  763.          serInit        : InitPort(Event.InfoByte);
  764.          serDeInit      : RemovePort(Event.InfoByte);
  765.          serRaiseDTR    : DTRState(Event.InfoByte,TRUE);
  766.          serLowerDTR    : DTRState(Event.InfoByte,FALSE);
  767.          serPurgeTx     : PurgeOutputBuf(Event.InfoByte);
  768.          serPurgeRx     : PurgeInputBuf(Event.InfoByte);
  769.          serFlow        : FlowControl(Event.InfoByte,HI(Event.InfoWord));
  770.          serCarrierReq  : SerialRequest(serCarrierReq,Event.InfoByte);
  771.          serTxBufferReq : SerialRequest(serTxBufferReq,Event.InfoByte);
  772.          serEventGenOn  : GenerateEvents(TRUE);
  773.          serEventGenOff : GenerateEvents(FALSE);
  774.          ELSE       EXIT;
  775.       END
  776.    ELSE
  777.       EXIT;
  778.    ClearEvent(Event)
  779. END;
  780.  
  781. {----------------------------------------------------------------------------}
  782.  
  783. PROCEDURE RegisterSerial;
  784. BEGIN
  785.    RegisterType(RSerial);
  786.    RegisterType(RSList);
  787. END;
  788.  
  789. {----------------------------------------------------------------------------}
  790.  
  791. END.